This code is Script 1 for Kitchel et al. TITLE manuscript.
This project is a collaborative effort to describe changes in taxonomic composition of fish communities around the world–as sampled by bottom trawl surveys.
Code by Zoë J. Kitchel
SESSION INFO
R version 4.2.1 (2022-06-23) Platform: x86_64-apple-darwin17.0 (64-bit) Running under: macOS Big Sur 11.7
Matrix products: default LAPACK: /Library/Frameworks/R.framework/Versions/4.2/Resources/lib/libRlapack.dylib
locale: [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
attached base packages: [1] stats graphics grDevices utils datasets methods base
other attached packages: [1] cowplot_1.1.1 sf_1.0-9 here_1.0.1
googledrive_2.0.0 [5] geosphere_1.5-14 taxize_0.9.100 rgdal_1.6-2
data.table_1.14.4 [9] rasterVis_0.51.4 lattice_0.20-45 gridExtra_2.3
viridis_0.6.2
[13] viridisLite_0.4.1 rgbif_3.7.3 rgeos_0.5-9 raster_3.6-11
[17] sp_1.5-0 tidyr_1.2.1 dplyr_1.0.10
loaded via a namespace (and not attached): [1] nlme_3.1-157 fs_1.5.2
bold_1.2.0 oai_0.4.0
[5] RColorBrewer_1.1-3 httr_1.4.4 rprojroot_2.0.3 bslib_0.4.0
[9] tools_4.2.1 utf8_1.2.2 R6_2.5.1 KernSmooth_2.23-20 [13] DBI_1.1.3
lazyeval_0.2.2 colorspace_2.0-3 tidyselect_1.2.0
[17] curl_4.3.3 compiler_4.2.1 cli_3.4.1 xml2_1.3.3
[21] sass_0.4.2 scales_1.2.1 classInt_0.4-8 hexbin_1.28.2
[25] proxy_0.4-27 stringr_1.4.1 digest_0.6.30 rmarkdown_2.17
[29] jpeg_0.1-9 pkgconfig_2.0.3 htmltools_0.5.3 fastmap_1.1.0
[33] rlang_1.0.6 rstudioapi_0.14 httpcode_0.3.0 jquerylib_0.1.4
[37] generics_0.1.3 zoo_1.8-11 jsonlite_1.8.3 magrittr_2.0.3
[41] interp_1.1-3 Rcpp_1.0.9 munsell_0.5.0 fansi_1.0.3
[45] ape_5.6-2 lifecycle_1.0.3 terra_1.6-41 stringi_1.7.8
[49] whisker_0.4 yaml_2.3.6 plyr_1.8.7 grid_4.2.1
[53] parallel_4.2.1 crayon_1.5.2 deldir_1.0-6 conditionz_0.1.0
[57] knitr_1.40 pillar_1.8.1 uuid_1.1-0 codetools_0.2-18
[61] crul_1.3 glue_1.6.2 evaluate_0.17 latticeExtra_0.6-30 [65]
png_0.1-7 vctrs_0.5.0 foreach_1.5.2 gtable_0.3.1
[69] purrr_0.3.5 reshape_0.8.9 assertthat_0.2.1 cachem_1.0.6
[73] ggplot2_3.3.6 xfun_0.34 e1071_1.7-12 class_7.3-20
[77] gargle_1.2.1 tibble_3.1.8 iterators_1.0.14 units_0.8-0
FishGlob.10year.spp.uniquehauls[,haul_count_per_survey :=
.N,.(survey, survey_unit, month, quarter, season)][,total_hauls_survey :=
.N,.(survey)][,haul_proportion :=
haul_count_per_survey/total_hauls_survey][,haul_count_per_survey_year :=
.N,.(survey, year, survey_unit, month, quarter, season)][,total_hauls_survey_year :=
.N,.(survey,year)][,haul_proportion_yearly := haul_count_per_survey_year/total_hauls_survey_year]
library(tidyverse)
library(sp)
library(raster)
library(rgeos)
library(rgbif)
library(viridis)
library(gridExtra)
library(rasterVis)
library(concaveman)
library(sf)
library(viridis)
set.seed(1)
#library(dggridR) #no longer works will find alternate method
library(data.table)
library(rgdal)
library(raster)
library(sp)
#library(rnaturalearth)
#library(rnaturalearthdata)
library(rgeos)
library(taxize) #standardizing names
library(geosphere) #to calculate distance between lat lon of grid cells
library(googledrive)
library(here)
library(sf)
library(cowplot)
Pull in compiled and cleaned data from FishGlob, downloaded on November 28, 2022 (V 1.5) at this link. This is typically compiled by Aurore Maureaud.
FishGlob_1.5 <- fread(here::here("data","FISHGLOB_v1.5_clean.csv"))
|--------------------------------------------------|
|==================================================|
|--------------------------------------------------|
|==================================================|
#add new column for season/quarter because survey_unit does not always show season correctly (i.e. GMEX)
#check first which survey_unit columns are okay and not
View(unique(FishGlob_1.5[,.(survey, season, quarter, survey_unit)]))
table(FishGlob_1.5$survey, FishGlob_1.5$quarter)
1 2 3 4
AI 0 18345 31847 666
BITS 45142 0 0 41947
CHL 0 15 10676 0
COL 0 0 0 0
DFO-HS 0 0 0 0
DFO-NF 8041 0 6712 166487
DFO-QCS 0 0 0 0
DFO-SOG 0 0 0 0
DFO-WCHG 0 0 0 0
DFO-WCVI 0 0 0 0
EBS 0 73381 73394 0
EVHOE 0 0 0 67226
FALK 9099 559 275 1872
FR-CGFS 0 0 0 25739
GIN 15037 11993 5174 13185
GMEX 0 103345 80130 191720
GOA 0 58546 74900 65
GRL-DE 0 0 0 0
GSL-N 9565 1002 79691 3654
GSL-S 0 0 62461 222
ICE-GFS 184468 417 0 0
IE-IGFS 0 0 0 69350
IS-MOAG 4365 4619 4150 4912
IS-TAU 1151 1619 1223 1491
MEDITS 0 392681 0 0
MRT 825 2330 165 4595
NAM 25081 761 1052 1512
NEUS 0 0 0 140779
NIGFS 15797 0 0 13656
Nor-BTS 108310 9032 73926 59294
NS-IBTS 228975 0 135189 0
NZ-CHAT 50298 0 0 4087
NZ-ECSI 0 15753 0 0
NZ-SUBA 0 0 0 21767
NZ-WCSI 6694 10942 0 0
PT-IBTS 0 0 0 13821
ROCKALL 0 0 11114 0
S-GEORG 9405 576 710 0
SCS 38840 3016 89320 9805
SEUS 0 89257 97868 99766
SWC-IBTS 41634 0 0 39119
WBLS 0 317 0 397
WCANN 0 57436 93988 21865
WCTRI 0 0 0 0
ZAF 41445 33062 21247 2916
#not completely dealing with this now, but will atleast add in season for GMEX to survey unit for now
FishGlob_1.5[survey == "GMEX", survey_unit := paste0(survey,"-",season)]
Specific Regional Fixes
GSL North: we have data 1980-2019, but gear changes in 2004/2005, so let’s use later portion (more consistent months of sampling; 2005-2019; 15 years) South: we have data 1970-2019, but gear/vessel changes in 1985 and again in 1992, so again let’s use later portion (1992-2019; 27 years)
##Spatial and Temporal Patterns in All Trawl Surveys Let’s look at hauls per year/month and year/quarter and year/season visually
#unique haul, survey, quarter, season, year
FishGlob.uniquehauls <- unique(FishGlob_1.5[,.(survey, survey_unit, year,month,quarter,season,haul_id)])
FishGlob.uniquehauls[,haul_counts_per_survey_season_month :=.N,.(survey, month, season)][, #count # hauls per survey, season, and month
haul_counts_per_survey_quarter_month :=.N,.(survey, month, quarter)][,#count # hauls per survey, month, and quarter
total_hauls_survey :=.N,.(survey)][,#count # hauls per survey in all years
#proportion of hauls for each survey, season, and month divided by total # over all years
haul_proportion_survey_season :=haul_counts_per_survey_season_month/total_hauls_survey][,
#proportion of hauls for each survey, quarter, and month divided by total # over all years
haul_proportion_survey_quarter :=haul_counts_per_survey_quarter_month/total_hauls_survey][,
haul_count_per_survey_year_month :=.N,.(year, survey_unit, month)][, #count # hauls per survey unit, year, and month
total_hauls_survey_year := .N,.(survey_unit,year)][, #count total # hauls per survey unit and year
#proportion of hauls for each survey unit and month divided by total # hauls within a survey unit within a year
haul_proportion_month_yearly := haul_count_per_survey_year_month/total_hauls_survey_year][,
haul_count_per_survey_year_quarter :=.N,.(year, survey_unit, quarter)][, #count # hauls per survey unit, year, and month
#proportion of hauls for each survey unit and month divided by total # hauls within a survey unit within a year
haul_proportion_quarter_yearly := haul_count_per_survey_year_quarter/total_hauls_survey_year]
FishGlob.uniquehauls.season <- unique(FishGlob.uniquehauls[,.(survey, month, season, haul_counts_per_survey_season_month,total_hauls_survey, haul_proportion_survey_season)]) #rel sampling by season across all years
FishGlob.uniquehauls.quarter <- unique(FishGlob.uniquehauls[,.(survey, month, quarter, haul_counts_per_survey_quarter_month,total_hauls_survey, haul_proportion_survey_quarter)]) #reel sampling by quarter across all years
FishGlob.uniquehauls.annual.month <- unique(FishGlob.uniquehauls[,.(survey, year, survey_unit, month, haul_count_per_survey_year_month,total_hauls_survey_year,haul_proportion_month_yearly)]) #relative sampling by month within years
FishGlob.uniquehauls.annual.quarter <- unique(FishGlob.uniquehauls[,.(survey, year, survey_unit, quarter, haul_count_per_survey_year_quarter,total_hauls_survey_year,haul_proportion_quarter_yearly)]) #relative sampling by month within years
#how does #hauls vary with season and month?
survey_season_month_hauls <- ggplot(FishGlob.10year.spp.uniquehauls.season) +
geom_tile(aes(x = factor(month), y = factor(season), fill = haul_proportion_survey_season),color = "white") +
scale_fill_viridis() +
labs(x = "Month", y = "Season",fill = "Proportion of All Survey Hauls in FishGlob") +
facet_wrap(~survey,scales = "free_y") +
theme_classic()
ggsave(survey_season_month_hauls, filename = "survey_season_month_hauls.pdf",path = here::here("figures","view_data"), height = 5, width = 15, units = "in")
#how does #hauls vary with quarter and month?
survey_quarter_month_hauls <- ggplot(FishGlob.uniquehauls.quarter) +
geom_tile(aes(x = factor(month), y = factor(quarter), fill = haul_proportion_survey_quarter),color = "white") +
scale_fill_viridis() +
labs(x = "Month", y = "Quarter",fill = "Proportion of All Survey Hauls in FishGlob") +
facet_wrap(~survey,scales = "free_y") +
theme_classic()
ggsave(survey_quarter_month_hauls, filename = "survey_quarter_month_hauls.pdf",path = here::here("figures","view_data"), height = 5, width = 15, units = "in")
#how does #hauls vary with year and month?
year_survey_month_hauls <- ggplot(FishGlob.uniquehauls.annual.month) +
geom_tile(aes(x = year, y = factor(month), fill = haul_proportion_month_yearly),color = "white") +
scale_fill_viridis() +
labs(x = "Year", y = "Month",fill = "Proportion of Annual Hauls") +
facet_wrap(~survey_unit,scales = "free_y") +
theme_classic()
ggsave(year_survey_month_hauls, filename = "year_survey_month_hauls.pdf",path = here::here("figures","view_data"), height = 8, width = 16, units = "in")
ggsave(year_survey_month_hauls, filename = "year_survey_month_hauls.pdf",path = here::here("figures","view_data"), height = 8, width = 16, units = "in")
#how does #hauls vary with year and month?
year_survey_quarter_hauls <- ggplot(FishGlob.uniquehauls.annual.quarter) +
geom_tile(aes(x = year, y = factor(quarter), fill = haul_proportion_quarter_yearly),color = "white") +
scale_fill_viridis() +
labs(x = "Year", y = "Quarter",fill = "Proportion of Annual Hauls") +
facet_wrap(~survey_unit,scales = "free_y") +
theme_classic()
ggsave(year_survey_quarter_hauls, filename = "year_survey_quarter_hauls.pdf",path = here::here("figures","view_data"), height = 8, width = 16, units = "in")
ggsave(year_survey_quarter_hauls, filename = "year_survey_quarter_hauls.pdf",path = here::here("figures","view_data"), height = 8, width = 16, units = "in")
Now, let’s look at how location of sampling varies by month of sampling and year of sampling
location_by_year <- ggplot(FishGlob.uniquehauls) +
geom_point(aes(x = longitude_adj, y = latitude, color = year), size = 0.3, alpha = 0.5) +
scale_color_viridis() +
facet_wrap(~survey_unit, scales = "free") +
theme_classic()
ggsave(location_by_year, filename = "location_by_year.pdf",path = here::here("figures","view_data"), height = 8, width = 12, units = "in")
ggsave(location_by_year, filename = "location_by_year.jpg",path = here::here("figures","view_data"), height = 8, width = 12, units = "in")
ggsave(location_by_year, filename = "location_by_year.eps",path = here::here("figures","view_data"), height = 8, width = 12, units = "in")
location_by_month <- ggplot(FishGlob.uniquehauls) +
geom_point(aes(x = longitude_adj, y = latitude, color = month), size = 0.3, alpha = 0.5) +
scale_color_viridis(option = "plasma") +
facet_wrap(~survey_unit, scales = "free") +
theme_classic()
ggsave(location_by_month, filename = "location_by_month.pdf",path = here::here("figures","view_data"), height = 8, width = 12, units = "in")
ggsave(location_by_month, filename = "location_by_month.jpg",path = here::here("figures","view_data"), height = 8, width = 12, units = "in")
ggsave(location_by_month, filename = "location_by_month.eps",path = here::here("figures","view_data"), height = 8, width = 12, units = "in")
###Because time is an essential component of these analyses, we will get rid of any survey x season combinations that are not sampled for at least 10 years
NB: *NS_IBTS (North Sea) is best examined only for 1st and 3rd quarter (pers communication, Aurore Maureaud)
length(unique(FishGlob.10year[,as.character(survey_unit)])) #45 unique survey/season (8 fewer) combinations
[1] 46
###For taxonomic analyses, resolution to species is required. Therefore, we will exclude any observations not resolved to species.
FishGlob.10year.spp <- FishGlob.10year[rank == "Species",] #4,110,764 total observations (253,564 fewer)
#remove full species database
rm(FishGlob.10year)
Survey specific changes (These have not actually been implemented as of February 6 2022; standardizations for time and space should catch these)
From Batt et al. 2017 “In the Eastern Bering Sea, sampling years prior to 1984 (data begin in 1982) were excluded from analysis due to large apparent increases in the number of species recorded in the first two years.”
“In the Gulf of Mexico, we restricted our analysis to data from 1984 - 2000 (full range 1982-2014); if all years had been used, the number of sites sampled in at least 85% of years would drop from 39 to 13.”
“In the Southeast U.S., data from 1989 (data begin in 1989) were excluded because several sites were not sampled in this year, and if this year had been used, the number of sites sampled in at least 85% of years would drop from 24 to 23 (with only 21 sites sampled in 1989).”
“In the Northeast U.S., we excluded data from years prior to 1982 (data begin in 1968). Years prior to 1979 were excluded because strata in the southern tip of the region (between approximately 34.5o N and 35o N) were not regularly sampled during this time. A site in the Gulf of Maine (-69.25o E 43.25o N) was not sampled consistently between 1979 and 1981, and including these years in the analysis would have prevented this site from being included in the analysis (which would have reduced total sites from 100 to 99).” #Alexa says start in 1968/1972
“In Newfoundland, years prior to 1996 (first year was 1992) were excluded because many sites were not sampled. If all years had been used (1992 onward), total number of sites sampled in at least 85% of years would have been decreased from 191 to 53; if data from 1995 onward had been included, number of sites would have been 179.”
Maybe throw out last year of triannual survey for West Coast US (overlaps with first)
(Skipping for now, hopefully our cleaning procedure will cover our bases here)
###Standardize observations for all regions
(This is preliminary code where we use threshold of 70% observation coverage for getting rid of years and n = 1/year for keeping cells)
At some point in the near future, I will just use Laura’s code here, or perhaps her final data product where we eliminate observations that don’t match consistent spatial footprint but limit whether this happens in years or locations by # of observations lost.
####Edit function to create grid From here
We will use cell size of 7,774.2 km^2, as that will match grid cell size of 8 in dggridr. We can’t use the package dggridr unfortunately because it doesn’t work for this version of R (and others have had this issue too). https://github.com/r-barnes/dggridR For Norway (?) we will use cell size of 23,322.2 km^2 because the sites are further away from each other.
Make sampling locations into spatial points
#delete if NA for longitude or latitude
FishGlob.10year.spp <- FishGlob.10year.spp[complete.cases(FishGlob.10year.spp[,.(longitude, latitude)])] #4,110,727 observations, loss of 37
Match lat/lon sampling points to hexagonal cells, so that we can see how many cells to keep to maintain a lot of observation points
FishGlob.10year.spp.cells <- data.table()
#two potential cell sizes
#set cell area (depends on whether or not it's Norway)
cell_area_all <- 7774.2 #km2 (8 from dggrdr)
cell_area_norway <- 23322.2 #km2 (7 from dggrdr; if you want to use different resolution, not doing as of now)
for(i in 1:length(all_survey_seasons)){
FishGlob.10year.spp_subset <- FishGlob.10year.spp[survey_unit == all_survey_seasons[i],]
#unique lat lon combos
FishGlob.10year.spp_subset_unique <- unique(FishGlob.10year.spp_subset[,.(longitude,latitude,haul_id,year)])
#coordinates to Spatial Points Object
if(max(FishGlob.10year.spp_subset_unique[,longitude]) - min(FishGlob.10year.spp_subset_unique[,longitude]) > 359){ #if survey region crosses dateline, use st_shift_longitude()
sp <- FishGlob.10year.spp_subset_unique %>%
st_as_sf(coords = c("longitude","latitude"), crs = 4326) %>%
st_shift_longitude()
}else{
sp <- FishGlob.10year.spp_subset_unique %>%
st_as_sf(coords = c("longitude","latitude"), crs = 4326)
}
sp.t <- as(sp, "Spatial")
proj4string(sp.t) <- CRS("+proj=longlat")
proj <- ifelse(max(FishGlob.10year.spp_subset_unique[,longitude]) - min(FishGlob.10year.spp_subset_unique[,longitude]) > 359, #if survey region crosses dateline, use +lon_0=-140 instead of +lon_0=0
"+proj=robin +lon_0=-140 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=km +no_defs",
"+proj=robin +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=km +no_defs")
sp.p <- spTransform(sp.t, CRS(proj)) #note km^2 units
#use Concaveman to convert points to polygon
polygon <- concaveman(sp, 2, 3)
polygon_spapol <- as(polygon, "Spatial") #convert simple polygon feature to spatial polygon
proj4string(polygon_spapol) <- CRS("+proj=longlat")
polygon_spapol.p <- spTransform(polygon_spapol, CRS(proj)) #note km^2 units
#create grid
#set cell_area based on whether or not it's the Norway survey
# cell_area_km <- ifelse(all_survey_seasons[i] == "Nor-BTS", cell_area_norway, cell_area_all) #note this is in kilometers (if you want to use different cell resolution for Norway, not doing as of now)
cell_area_km = cell_area_all
#calculate cell_diameter of hexagons from cell_areas
cell_diameter_km <- sqrt(2 * cell_area_km / sqrt(3)) # in meters
ext <- as(extent(polygon_spapol.p)
+ 2*cell_diameter_km #add a buffer to make sure all observations are assigned a cell
, "SpatialPolygons")
# plot(ext)
# plot(sp.p, add = T, pch = ".")
projection(ext) <- projection(polygon_spapol.p) #match projection
# generate array of hexagon centers
g <- spsample(ext, type = "hexagonal", cellsize = cell_diameter_km, offset = c(0.5, 0.5))
# convert center points to hexagons
g <- HexPoints2SpatialPolygons(g, dx = cell_diameter_km)
plot(g)
plot(sp.p, add = T, pch = ".")
title(paste0(all_survey_seasons[i]))
#link lat lon to cell#
#where do they overlap
sp.p$cell_ID <- over(sp.p,g) #over(x=location of queries, y = layer from which geometries are queried)
#link lat long to cell #s
FishGlob.10year.spp_subset_unique[,cell_ID := sp.p$cell_ID][,cell_year_count := .N, .(cell_ID, year)]
#link back to subsetted database of observations
FishGlob.10year.spp_subset.cells <- FishGlob.10year.spp_subset[FishGlob.10year.spp_subset_unique, on = c("longitude", "latitude","year","haul_id")]
FishGlob.10year.spp.cells <- rbind(FishGlob.10year.spp.cells, FishGlob.10year.spp_subset.cells)
#make sure all projections match for binding of polygons
polygon_spapol.forbind <- spTransform(polygon_spapol.p,
CRS=CRS( "+proj=robin +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=km +no_defs"))
polygon_spapol.forbind$survey_unit <- all_survey_seasons[i]
#bind polygons into spdf
if(i ==1){
all_survey_seasons_polygon <- polygon_spapol.forbind #if first, just polygon to start
}else{
all_survey_seasons_polygon <- rbind(all_survey_seasons_polygon, polygon_spapol.forbind) #if not first, bind new polygon to first polygon
}
}
Warning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among othersWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.htmlWarning: CRS object has comment, which is lost in output; in tests, see
https://cran.r-project.org/web/packages/sp/vignettes/CRS_warnings.html
Warning: PROJ support is provided by the sf and terra packages among others
writeOGR(all_survey_seasons_polygon, dsn = here::here("output/shapefiles"))
Warning: OGR support is provided by the sf and terra packages among othersWarning: OGR support is provided by the sf and terra packages among othersError in match(driver, drvs$name) :
argument "driver" is missing, with no default
Animate changes in sampling sites over time for each region in order to identify any huge issues
install.packages(c('gapminder','gganimate','gifski'))
trying URL 'https://cran.rstudio.com/bin/macosx/contrib/4.2/gapminder_0.3.0.tgz'
Content type 'application/x-gzip' length 2031842 bytes (1.9 MB)
==================================================
downloaded 1.9 MB
trying URL 'https://cran.rstudio.com/bin/macosx/contrib/4.2/gganimate_1.0.8.tgz'
Content type 'application/x-gzip' length 1294329 bytes (1.2 MB)
==================================================
downloaded 1.2 MB
trying URL 'https://cran.rstudio.com/bin/macosx/contrib/4.2/gifski_1.6.6-1.tgz'
Content type 'application/x-gzip' length 2662673 bytes (2.5 MB)
==================================================
downloaded 2.5 MB
The downloaded binary packages are in
/var/folders/0m/zw4hywk9177dsnzhv4w0b5pm0000gn/T//Rtmp8OiF94/downloaded_packages
Merge all shapefiles together in order to send to Sea Around Us team to obtain fishing specific fishing data.
Standardize observations by # of hauls per cell and # cells sampled per year
Remove any years that sample less than 85% of cells ever sampled Remove any cells that are sampled in less than 85% of years
#account of data loss by standardization
data_loss <- data.table(survey_unit=all_survey_seasons,
year_threshold=as.numeric(NA),
cell_threshold=as.numeric(NA),
percent_years_excluded=as.numeric(NA),
percent_hauls_excluded_by_year=as.numeric(NA),
percent_obs_excluded_by_year=as.numeric(NA),
percent_cells_excluded=as.numeric(NA),
percent_hauls_excluded_total=as.numeric(NA),
percent_obs_excluded_total=as.numeric(NA))
FishGlob.10year.spp.cells_subset.wellsampledyearscells_complete <- data.table()
for (i in 1:length(all_survey_seasons)) {
#subset to region
FishGlob.10year.spp.cells_subset <- FishGlob.10year.spp.cells[survey_unit == all_survey_seasons[i],]
#unique year, #cells sampled
year_cells_sampled <- unique(FishGlob.10year.spp.cells_subset[,.(year,cell_ID)])
year_cells_sampled <- year_cells_sampled[,yearly_cell_count := .N,year]
#we'll make benchmark 70% just for now
year_benchmark <- 0.70
benchmark_value <- year_benchmark*max(year_cells_sampled[,yearly_cell_count])
#only keep years where over 70% of cells are sampled
year_cells_sampled[,benchmark := yearly_cell_count >= benchmark_value]
years_deleted <- unique(year_cells_sampled[benchmark == F,year]) #which years are left out?
years_kept <-unique(year_cells_sampled[benchmark ==T,year]) #which years to keep
years_deleted_percent <- round(length(years_deleted)/length(unique(year_cells_sampled[,year]))*100,1)
#print the years that are left out
print(ifelse(length(years_deleted) == 0, paste0(all_survey_seasons[i], " Years left out = 0"), paste0(all_survey_seasons[i], " Years left out = ", years_deleted, collapse = ",")))
print(paste0(years_deleted_percent, "% of Years Excluded"))
#reduce to years that are well sampled
FishGlob.10year.spp.cells_subset.wellsampledyears <- FishGlob.10year.spp.cells_subset[year %in% years_kept,]
#how many observations does this remove?
percent_obs_removed_year <- round((nrow(FishGlob.10year.spp.cells_subset)-nrow(FishGlob.10year.spp.cells_subset.wellsampledyears))/nrow(FishGlob.10year.spp.cells_subset)*100,2)
percent_hauls_removed_year <- round((length(unique(FishGlob.10year.spp.cells_subset[,haul_id]))-length(unique(FishGlob.10year.spp.cells_subset.wellsampledyears[,haul_id])))/length(unique(FishGlob.10year.spp.cells_subset[,haul_id]))*100,2)
#identify any cells that are not sampled in 85% of years
FishGlob.10year.spp.cells_subset.wellsampledyears[,year_cell_count := length(unique(haul_id)),.(year,cell_ID)] # unique haul ids per cell per year
cell_by_year <- unique(FishGlob.10year.spp.cells_subset.wellsampledyears[, .(cell_ID,year)])
cell_by_year[,years_per_cell := .N,cell_ID]
#cell ids to remove and keep
#in any year, which cells are sampled in less than 70% of years
#we'll make benchmark 70% just for now
cell_benchmark <- 0.70
benchmark_value_year_count <- cell_benchmark*max(cell_by_year[,years_per_cell])
cell_id_remove <- unique(cell_by_year[years_per_cell<benchmark_value_year_count,cell_ID])
cells_deleted_percent <- round(length(cell_id_remove)/length(unique(FishGlob.10year.spp.cells_subset.wellsampledyears[,cell_ID]))*100,1)
#this removes 40% of cells from Aleutian islands, seems like too much, I will return to this
#reduce to cells that are well sampled
FishGlob.10year.spp.cells_subset.wellsampledyearscells <- FishGlob.10year.spp.cells_subset.wellsampledyears[!cell_ID %in% cell_id_remove,]
#add to cleaned data table of all regions
FishGlob.10year.spp.cells_subset.wellsampledyearscells_complete <- rbind(FishGlob.10year.spp.cells_subset.wellsampledyearscells_complete, FishGlob.10year.spp.cells_subset.wellsampledyearscells)
#What percent of hauls does this remove?
hauls_removed_yearcell <- round((length(unique(FishGlob.10year.spp.cells_subset[,haul_id]))-length(unique(FishGlob.10year.spp.cells_subset.wellsampledyearscells[,haul_id])))/length(unique(FishGlob.10year.spp.cells_subset[,haul_id]))*100,1)
#What percent of observations does this remove?
obs_removed_yearcell <- round((nrow(FishGlob.10year.spp.cells_subset)-nrow(FishGlob.10year.spp.cells_subset.wellsampledyearscells))/nrow(FishGlob.10year.spp.cells_subset)*100,1)
cell_id_remove.string <- paste(cell_id_remove, collapse = ", ")
obs_removed.string <- paste(obs_removed_yearcell, collapse = ", ")
#build data table from this reduced output
FishGlob.10year.spp.cells_subset.wellsampledyearscells_complete <- rbind(FishGlob.10year.spp.cells_subset.wellsampledyearscells_complete, FishGlob.10year.spp.cells_subset.wellsampledyearscells)
#fill out table with statistics of dropped observations
data_loss[i, "year_threshold"] = year_benchmark
data_loss[i, "cell_threshold"] = cell_benchmark
data_loss[i, "percent_years_excluded"] = years_deleted_percent
data_loss[i, "percent_hauls_excluded_by_year"] = percent_hauls_removed_year
data_loss[i, "percent_obs_excluded_by_year"] = percent_obs_removed_year
data_loss[i, "percent_cells_excluded"] = cells_deleted_percent
data_loss[i, "percent_hauls_excluded_total"] = hauls_removed_yearcell
data_loss[i, "percent_obs_excluded_total"] = obs_removed_yearcell
#print portion of cells that are left out
print(ifelse(length(cell_id_remove) == 0, paste0(all_survey_seasons[i], " Cells left out = 0"), paste0(all_survey_seasons[i], " Cells left out = ", cell_id_remove.string, ", ",cells_deleted_percent, "% Cells Excluded, ",hauls_removed_yearcell,"% Hauls Removed, ", obs_removed_yearcell, "% Observations Removed")))
}
[1] "AI Years left out = 0"
[1] "0% of Years Excluded"
[1] "AI Cells left out = 27, 53, 5% Cells Excluded, 0.3% Hauls Removed, 0.3% Observations Removed"
[1] "BITS-1 Years left out = 1992,BITS-1 Years left out = 1993,BITS-1 Years left out = 1994,BITS-1 Years left out = 1995,BITS-1 Years left out = 1996,BITS-1 Years left out = 1997,BITS-1 Years left out = 1998,BITS-1 Years left out = 1999,BITS-1 Years left out = 2000"
[1] "31% of Years Excluded"
[1] "BITS-1 Cells left out = 50, 22, 65, 53, 78, 19, 80, 69, 20, 20.9% Cells Excluded, 9.3% Hauls Removed, 9.5% Observations Removed"
[1] "BITS-4 Years left out = 1996,BITS-4 Years left out = 1999"
[1] "8.7% of Years Excluded"
[1] "BITS-4 Cells left out = 36, 24, 79, 41, 6, 26, 22, 78, 5, 20, 66, 24.4% Cells Excluded, 6.4% Hauls Removed, 5.9% Observations Removed"
[1] "CHL Years left out = 2010"
[1] "5.9% of Years Excluded"
[1] "CHL Cells left out = 10, 4, 5, 46, 26, 22, 17, 30.4% Cells Excluded, 10.4% Hauls Removed, 11.7% Observations Removed"
[1] "DFO-NF Years left out = 2014"
[1] "4% of Years Excluded"
[1] "DFO-NF Cells left out = 49, 66, 60, 59, 70, 79, 89, 96, 106, 88, 93, 84, 149, 164, 165, 153, 145, 166, 46, 126, 21, 5, 22% Cells Excluded, 6.3% Hauls Removed, 6.7% Observations Removed"
[1] "DFO-QCS Years left out = 0"
[1] "0% of Years Excluded"
[1] "DFO-QCS Cells left out = 14, 9.1% Cells Excluded, 0.1% Hauls Removed, 0.1% Observations Removed"
[1] "EBS Years left out = 0"
[1] "0% of Years Excluded"
[1] "EBS Cells left out = 163, 1.1% Cells Excluded, 0% Hauls Removed, 0% Observations Removed"
[1] "EVHOE Years left out = 2017"
[1] "4.2% of Years Excluded"
[1] "EVHOE Cells left out = 42, 49, 72, 119, 67, 118, 100, 117, 123, 112, 90, 23.4% Cells Excluded, 3.9% Hauls Removed, 4.5% Observations Removed"
[1] "FALK Years left out = 1994,FALK Years left out = 1995,FALK Years left out = 2003,FALK Years left out = 1999,FALK Years left out = 2000,FALK Years left out = 2001,FALK Years left out = 2006,FALK Years left out = 2007,FALK Years left out = 2010,FALK Years left out = 2011,FALK Years left out = 2015,FALK Years left out = 2016,FALK Years left out = 2017,FALK Years left out = 2018,FALK Years left out = 2019,FALK Years left out = 2020,FALK Years left out = 2021"
[1] "89.5% of Years Excluded"
[1] "FALK Cells left out = 29, 18, 28, 27, 37, 38, 47, 21.2% Cells Excluded, 87.1% Hauls Removed, 88.7% Observations Removed"
[1] "FR-CGFS Years left out = 2020"
[1] "4.3% of Years Excluded"
[1] "FR-CGFS Cells left out = 3, 9.1% Cells Excluded, 2.9% Hauls Removed, 4.2% Observations Removed"
[1] "GIN Years left out = 1985,GIN Years left out = 1986,GIN Years left out = 1987,GIN Years left out = 1988,GIN Years left out = 1989,GIN Years left out = 1990,GIN Years left out = 1991,GIN Years left out = 1994,GIN Years left out = 1995,GIN Years left out = 1998,GIN Years left out = 2012,GIN Years left out = 2009,GIN Years left out = 2004,GIN Years left out = 2005"
[1] "63.6% of Years Excluded"
[1] "GIN Cells left out = 2, 3, 10, 25% Cells Excluded, 49.1% Hauls Removed, 50.2% Observations Removed"
[1] "GMEX Years left out = 2003,GMEX Years left out = 1996,GMEX Years left out = 1997,GMEX Years left out = 1991,GMEX Years left out = 1994,GMEX Years left out = 2002,GMEX Years left out = 2004,GMEX Years left out = 1989,GMEX Years left out = 1993,GMEX Years left out = 1998,GMEX Years left out = 1988,GMEX Years left out = 1990,GMEX Years left out = 1992,GMEX Years left out = 1999,GMEX Years left out = 2001,GMEX Years left out = 2000,GMEX Years left out = 1987,GMEX Years left out = 1995,GMEX Years left out = 2006,GMEX Years left out = 2005,GMEX Years left out = 2007,GMEX Years left out = 2008"
[1] "64.7% of Years Excluded"
[1] "GMEX Cells left out = 123, 138, 147, 30, 131, 146, 82, 33, 91, 16.4% Cells Excluded, 63.3% Hauls Removed, 60.7% Observations Removed"
[1] "GOA Years left out = 2001"
[1] "6.2% of Years Excluded"
[1] "GOA Cells left out = 83, 152, 312, 229, 282, 305, 387, 248, 319, 354, 379, 388, 191, 213, 267, 382, 42, 17% Cells Excluded, 5.5% Hauls Removed, 5.2% Observations Removed"
[1] "GRL-DE Years left out = 1981,GRL-DE Years left out = 1992,GRL-DE Years left out = 1994,GRL-DE Years left out = 1995,GRL-DE Years left out = 1997,GRL-DE Years left out = 2001,GRL-DE Years left out = 2002,GRL-DE Years left out = 2003,GRL-DE Years left out = 2005,GRL-DE Years left out = 2011,GRL-DE Years left out = 2016,GRL-DE Years left out = 2017,GRL-DE Years left out = 1999,GRL-DE Years left out = 2009"
[1] "37.8% of Years Excluded"
[1] "GRL-DE Cells left out = 125, 183, 182, 204, 181, 159, 201, 199, 33, 32, 161, 174, 55, 202, 205, 9, 130, 173, 36.7% Cells Excluded, 31.2% Hauls Removed, 31.2% Observations Removed"
[1] "GSL-N Years left out = 1980,GSL-N Years left out = 1981,GSL-N Years left out = 1983,GSL-N Years left out = 1984,GSL-N Years left out = 1985,GSL-N Years left out = 1989"
[1] "15.4% of Years Excluded"
[1] "GSL-N Cells left out = 37, 40, 145, 115, 69, 100, 24, 10, 25, 19.6% Cells Excluded, 6.8% Hauls Removed, 4.4% Observations Removed"
[1] "GSL-S Years left out = 1970"
[1] "2% of Years Excluded"
[1] "GSL-S Cells left out = 3, 9, 26, 15% Cells Excluded, 2.5% Hauls Removed, 2.6% Observations Removed"
[1] "ICE-GFS Years left out = 0"
[1] "0% of Years Excluded"
[1] "ICE-GFS Cells left out = 36, 2% Cells Excluded, 0.1% Hauls Removed, 0.1% Observations Removed"
[1] "IE-IGFS Years left out = 0"
[1] "0% of Years Excluded"
[1] "IE-IGFS Cells left out = 55, 56, 57, 66, 65, 45, 36, 37, 46, 74, 75, 49, 39, 30, 92, 90, 80, 27, 33, 3, 59, 42% Cells Excluded, 4.9% Hauls Removed, 4.7% Observations Removed"
[1] "IS-MOAG Years left out = 2012"
[1] "5.9% of Years Excluded"
[1] "IS-MOAG Cells left out = 0"
[1] "MEDITS Years left out = 0"
[1] "0% of Years Excluded"
[1] "MEDITS Cells left out = 78, 79, 80, 81, 239, 318, 280, 277, 478, 476, 516, 326, 363, 244, 97, 57, 58, 59, 98, 95, 595, 404, 408, 175, 182, 221, 183, 220, 219, 218, 256, 144, 180, 257, 181, 294, 184, 142, 143, 105, 222, 185, 147, 148, 146, 107, 145, 224, 69, 68, 106, 67, 76, 37, 75, 77, 38, 37.3% Cells Excluded, 9.9% Hauls Removed, 10.6% Observations Removed"
[1] "MRT Years left out = 2000,MRT Years left out = 2006"
[1] "14.3% of Years Excluded"
[1] "MRT Cells left out = 26, 14, 22, 25% Cells Excluded, 8% Hauls Removed, 7.5% Observations Removed"
[1] "NAM Years left out = 1998,NAM Years left out = 2018"
[1] "9.5% of Years Excluded"
[1] "NAM Cells left out = 12, 36, 118, 32, 82, 26, 105, 22, 452, 451, 95, 27.5% Cells Excluded, 4.4% Hauls Removed, 3.7% Observations Removed"
[1] "NEUS-Fall Years left out = 1963,NEUS-Fall Years left out = 1964,NEUS-Fall Years left out = 1965,NEUS-Fall Years left out = 1966,NEUS-Fall Years left out = 1967,NEUS-Fall Years left out = 1968,NEUS-Fall Years left out = 1969,NEUS-Fall Years left out = 1970,NEUS-Fall Years left out = 1973,NEUS-Fall Years left out = 1984,NEUS-Fall Years left out = 1985,NEUS-Fall Years left out = 1986,NEUS-Fall Years left out = 1987,NEUS-Fall Years left out = 1988,NEUS-Fall Years left out = 1989,NEUS-Fall Years left out = 1990,NEUS-Fall Years left out = 1991,NEUS-Fall Years left out = 1992,NEUS-Fall Years left out = 1993,NEUS-Fall Years left out = 1994,NEUS-Fall Years left out = 1995,NEUS-Fall Years left out = 1996,NEUS-Fall Years left out = 1997,NEUS-Fall Years left out = 1998,NEUS-Fall Years left out = 1999,NEUS-Fall Years left out = 2001,NEUS-Fall Years left out = 2002,NEUS-Fall Years left out = 2004,NEUS-Fall Years left out = 2005,NEUS-Fall Years left out = 2006,NEUS-Fall Years left out = 2008,NEUS-Fall Years left out = 2009,NEUS-Fall Years left out = 2010,NEUS-Fall Years left out = 2011,NEUS-Fall Years left out = 2012,NEUS-Fall Years left out = 2013,NEUS-Fall Years left out = 2014,NEUS-Fall Years left out = 2016,NEUS-Fall Years left out = 2017,NEUS-Fall Years left out = 2018,NEUS-Fall Years left out = 2019"
[1] "71.9% of Years Excluded"
[1] "NEUS-Fall Cells left out = 448, 449, 471, 472, 494, 210, 188, 187, 165, 164, 163, 141, 140, 139, 116, 93, 92, 70, 47, 69, 25, 24, 46, 115, 138, 162, 186, 470, 301, 328, 36.6% Cells Excluded, 69.8% Hauls Removed, 72.3% Observations Removed"
[1] "NEUS-Spring Years left out = 1975,NEUS-Spring Years left out = 2020"
[1] "3.8% of Years Excluded"
[1] "NEUS-Spring Cells left out = 178, 312, 276, 258, 257, 137, 177, 275, 277, 238, 295, 296, 219, 59, 21, 40, 58, 41, 23, 39, 20, 38, 1, 2, 78, 115, 35.6% Cells Excluded, 6.4% Hauls Removed, 6.2% Observations Removed"
[1] "NIGFS Years left out = 2006,NIGFS Years left out = 2007"
[1] "13.3% of Years Excluded"
[1] "NIGFS Cells left out = 0"
[1] "Nor-BTS Years left out = 1982,Nor-BTS Years left out = 1985,Nor-BTS Years left out = 1986,Nor-BTS Years left out = 1988,Nor-BTS Years left out = 1989,Nor-BTS Years left out = 1999"
[1] "18.2% of Years Excluded"
[1] "Nor-BTS Cells left out = 439, 778, 440, 1264, 441, 1266, 1267, 1220, 891, 844, 892, 845, 1223, 893, 941, 894, 442, 895, 632, 680, 681, 729, 682, 846, 847, 942, 1037, 943, 1038, 944, 1039, 992, 1040, 993, 1041, 782, 1300, 1113, 1210, 1165, 1213, 1312, 1035, 1082, 1177, 1130, 1272, 1085, 1132, 1180, 1181, 1134, 1088, 946, 1042, 1089, 1183, 996, 1090, 1138, 1185, 1091, 248, 201, 249, 488, 971, 1036, 945, 1018, 1214, 1215, 843, 800, 848, 1131, 896, 897, 898, 899, 947, 994, 1262, 1268, 730, 203, 1396, 1397, 799, 1301, 1255, 1209, 900, 995, 202, 832, 1222, 849, 850, 851, 852, 901, 948, 1258, 1400, 635, 1083, 1251, 1273, 541, 684, 589, 637, 734, 492, 538, 1086, 1043, 1129, 1084, 1087, 902, 1176, 1178, 853, 949, 831, 833, 542, 1135, 1136, 1349, 1401, 1402, 1403, 1404, 1405, 1358, 1359, 1311, 1406, 1407, 1360, 1313, 1361, 1408, 1409, 1362, 1315, 1303, 1392, 1344, 1307, 1308, 1309, 1269, 1270, 683, 304, 110, 112, 300, 1316, 1411, 1364, 1317, 1365, 1318, 1319, 1320, 1322, 494, 883, 444, 493, 783, 801, 340, 342, 154, 250, 156, 157, 158, 298, 346, 686, 443, 826, 242, 343, 295, 390, 247, 153, 155, 1310, 395, 144, 335, 152, 109, 1363, 393, 884, 345, 396, 638, 391, 344, 297, 1395, 1456, 1457, 1410, 1224, 1393, 296, 106, 392, 397, 63, 1412, 1413, 1366, 1226, 1367, 1368, 1321, 1227, 1369, 1275, 434, 385, 61, 59, 60, 634, 12, 633, 1394, 62, 1259, 860, 812, 907, 859, 1391, 1343, 1261, 1353, 1306, 1225, 1179, 1137, 585, 586, 438, 107, 389, 60.5% Cells Excluded, 21.8% Hauls Removed, 18.2% Observations Removed"
[1] "NS-IBTS-1 Years left out = 1967,NS-IBTS-1 Years left out = 1968,NS-IBTS-1 Years left out = 1970,NS-IBTS-1 Years left out = 1971,NS-IBTS-1 Years left out = 1972,NS-IBTS-1 Years left out = 1973,NS-IBTS-1 Years left out = 1974,NS-IBTS-1 Years left out = 1975,NS-IBTS-1 Years left out = 1976,NS-IBTS-1 Years left out = 1977,NS-IBTS-1 Years left out = 1978,NS-IBTS-1 Years left out = 1979"
[1] "22.6% of Years Excluded"
[1] "NS-IBTS-1 Cells left out = 180, 188, 187, 219, 203, 127, 168, 82, 52, 112, 194, 105, 200, 37, 139, 20, 36, 21, 35, 19, 4, 34, 167, 253, 87, 22.5% Cells Excluded, 7.5% Hauls Removed, 7.1% Observations Removed"
[1] "NS-IBTS-3 Years left out = 1991"
[1] "3.3% of Years Excluded"
[1] "NS-IBTS-3 Cells left out = 104, 6, 37, 73, 89, 139, 21, 141, 188, 221, 163, 149, 108, 172, 120, 96, 156, 157, 81, 18.8% Cells Excluded, 4.3% Hauls Removed, 4.5% Observations Removed"
[1] "NZ-CHAT Years left out = 0"
[1] "0% of Years Excluded"
[1] "NZ-CHAT Cells left out = 48, 24, 47, 14, 40, 44, 10, 3, 1, 2, 45, 25, 4, 35.1% Cells Excluded, 6.4% Hauls Removed, 6.9% Observations Removed"
[1] "NZ-ECSI Years left out = 0"
[1] "0% of Years Excluded"
[1] "NZ-ECSI Cells left out = 32, 10% Cells Excluded, 1.2% Hauls Removed, 1.3% Observations Removed"
[1] "NZ-SUBA Years left out = 2016"
[1] "5.6% of Years Excluded"
[1] "NZ-SUBA Cells left out = 98, 84, 45, 30, 43, 29, 3, 2, 41, 39, 66, 56, 118, 122, 109, 121, 92, 87, 71, 4, 28, 52, 53, 120, 19, 32, 27, 93, 74, 99, 96, 97, 123, 18, 17, 65, 53.7% Cells Excluded, 28.4% Hauls Removed, 26.7% Observations Removed"
[1] "NZ-WCSI Years left out = 0"
[1] "0% of Years Excluded"
[1] "NZ-WCSI Cells left out = 39, 49, 1, 51, 25% Cells Excluded, 1.1% Hauls Removed, 0.8% Observations Removed"
[1] "PT-IBTS Years left out = 2018"
[1] "7.1% of Years Excluded"
[1] "PT-IBTS Cells left out = 0"
[1] "ROCKALL Years left out = 1999,ROCKALL Years left out = 2001,ROCKALL Years left out = 2002,ROCKALL Years left out = 2003,ROCKALL Years left out = 2005,ROCKALL Years left out = 2006,ROCKALL Years left out = 2007,ROCKALL Years left out = 2008,ROCKALL Years left out = 2009"
[1] "47.4% of Years Excluded"
[1] "ROCKALL Cells left out = 16, 6, 2, 37.5% Cells Excluded, 48% Hauls Removed, 44.7% Observations Removed"
[1] "S-GEORG Years left out = 2012"
[1] "4.8% of Years Excluded"
[1] "S-GEORG Cells left out = 16, 15, 23, 28, 19, 27.8% Cells Excluded, 2.7% Hauls Removed, 2% Observations Removed"
[1] "SCS-SPRING Years left out = 1987,SCS-SPRING Years left out = 1988,SCS-SPRING Years left out = 1989,SCS-SPRING Years left out = 1990,SCS-SPRING Years left out = 1992,SCS-SPRING Years left out = 1994,SCS-SPRING Years left out = 1996,SCS-SPRING Years left out = 1997,SCS-SPRING Years left out = 1998,SCS-SPRING Years left out = 1999,SCS-SPRING Years left out = 2000,SCS-SPRING Years left out = 2001,SCS-SPRING Years left out = 2002,SCS-SPRING Years left out = 2003,SCS-SPRING Years left out = 2005,SCS-SPRING Years left out = 2010,SCS-SPRING Years left out = 1993,SCS-SPRING Years left out = 2007,SCS-SPRING Years left out = 2018,SCS-SPRING Years left out = 1985,SCS-SPRING Years left out = 1991,SCS-SPRING Years left out = 1995,SCS-SPRING Years left out = 2009,SCS-SPRING Years left out = 2017,SCS-SPRING Years left out = 2008,SCS-SPRING Years left out = 1986,SCS-SPRING Years left out = 2006,SCS-SPRING Years left out = 2012,SCS-SPRING Years left out = 2020,SCS-SPRING Years left out = 2013,SCS-SPRING Years left out = 2004,SCS-SPRING Years left out = 2011,SCS-SPRING Years left out = 2015"
[1] "78.6% of Years Excluded"
[1] "SCS-SPRING Cells left out = 112, 97, 95, 113, 98, 99, 128, 114, 83, 48, 68, 50, 129, 130, 84, 115, 116, 101, 100, 143, 109, 33, 34, 47, 107, 85, 62, 32, 31, 16, 18, 19, 17, 45, 46, 2, 144, 69.8% Cells Excluded, 85.9% Hauls Removed, 84.2% Observations Removed"
[1] "SCS-SUMMER Years left out = 2018"
[1] "2% of Years Excluded"
[1] "SCS-SUMMER Cells left out = 64, 73, 14, 101, 13, 2, 69, 44, 89, 113, 102, 30, 25.5% Cells Excluded, 4.5% Hauls Removed, 5% Observations Removed"
[1] "SEUS-fall Years left out = 2018,SEUS-fall Years left out = 2019"
[1] "6.5% of Years Excluded"
[1] "SEUS-fall Cells left out = 85, 56, 2, 18.8% Cells Excluded, 6.8% Hauls Removed, 7.2% Observations Removed"
[1] "SEUS-spring Years left out = 0"
[1] "0% of Years Excluded"
[1] "SEUS-spring Cells left out = 85, 2, 13.3% Cells Excluded, 1.9% Hauls Removed, 2.1% Observations Removed"
[1] "SEUS-summer Years left out = 0"
[1] "0% of Years Excluded"
[1] "SEUS-summer Cells left out = 85, 2, 37, 18.8% Cells Excluded, 2.2% Hauls Removed, 2.2% Observations Removed"
[1] "SWC-IBTS-1 Years left out = 1985,SWC-IBTS-1 Years left out = 1986,SWC-IBTS-1 Years left out = 1990,SWC-IBTS-1 Years left out = 1992,SWC-IBTS-1 Years left out = 1993,SWC-IBTS-1 Years left out = 1994,SWC-IBTS-1 Years left out = 1995,SWC-IBTS-1 Years left out = 2007,SWC-IBTS-1 Years left out = 2009,SWC-IBTS-1 Years left out = 2010"
[1] "27.8% of Years Excluded"
[1] "SWC-IBTS-1 Cells left out = 19, 22, 21, 57, 74, 63, 36, 18, 10, 53, 39, 75, 73, 11, 46, 85, 84, 67, 76, 58, 48, 15, 24, 14, 5, 6, 61.9% Cells Excluded, 40.7% Hauls Removed, 39.9% Observations Removed"
[1] "SWC-IBTS-4 Years left out = 2011,SWC-IBTS-4 Years left out = 2013,SWC-IBTS-4 Years left out = 2017,SWC-IBTS-4 Years left out = 1992,SWC-IBTS-4 Years left out = 1994"
[1] "16.7% of Years Excluded"
[1] "SWC-IBTS-4 Cells left out = 171, 180, 167, 143, 97, 112, 123, 146, 72, 61, 50, 38, 27, 16, 28, 17, 84, 183, 195, 207, 73, 62, 51, 49, 39, 42, 63, 95, 26, 18, 30, 29, 32, 44, 54, 82, 194, 101, 100, 88, 77, 102, 113, 67.2% Cells Excluded, 31.8% Hauls Removed, 30.6% Observations Removed"
[1] "WCANN Years left out = 0"
[1] "0% of Years Excluded"
[1] "WCANN Cells left out = 157, 13, 3, 4, 8.7% Cells Excluded, 0.2% Hauls Removed, 0.2% Observations Removed"
[1] "WCTRI Years left out = 1986"
[1] "10% of Years Excluded"
[1] "WCTRI Cells left out = 11, 3, 40, 163, 18, 155, 150, 9, 24, 22.5% Cells Excluded, 11.6% Hauls Removed, 11.5% Observations Removed"
[1] "ZAF Years left out = 2001,ZAF Years left out = 1984,ZAF Years left out = 1985,ZAF Years left out = 1989,ZAF Years left out = 1990,ZAF Years left out = 2002"
[1] "24% of Years Excluded"
[1] "ZAF Cells left out = 7, 6, 34, 67, 53, 41, 14.3% Cells Excluded, 15.5% Hauls Removed, 11.9% Observations Removed"
#now, check again to see if any are less than 10 years
FishGlob.10year.spp.cells_subset.wellsampledyearscells_complete[,years_sampled_update := length(unique(year)),.(survey_unit)]
FishGlob.10year.spp.cells_subset.wellsampledyearscells_complete.10year <- FishGlob.10year.spp.cells_subset.wellsampledyearscells_complete[years_sampled_update >= 10,]
#saveRDS(FishGlob_cleaned.10year, here::here("output","region_season_cleaned_data","FishGlob_cleaned.10year.rds"))
#FishGlob_cleaned.10year <- readRDS(here::here("output","region_season_cleaned_data","FishGlob_cleaned.10year.rds"))
Plot unique trawl areas
#pull points
FishGlob_cleaned.10year.lat.lon <- unique(FishGlob_cleaned.10year[,.(longitude,latitude,survey)])
FishGlob_cleaned.10year.lat.lon.spdf <- SpatialPointsDataFrame(coords = FishGlob_cleaned.10year.lat.lon[,1:2], data = FishGlob_cleaned.10year.lat.lon,
proj4string = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"))
#ddgrdr grid for all points of tows that are used
FishGlob_cleaned.10year.lat.lon[,cell := dgGEO_to_SEQNUM(dggs, longitude, latitude)] #get corresponding grid cells
#centersof cells
FishGlob_cleaned.10year.lat.lon_cellcenters <- dgSEQNUM_to_GEO(dggs, FishGlob_cleaned.10year.lat.lon[,cell])
#linking cell centers to unique_EBS_latlon
FishGlob_cleaned.10year.lat.lon[,LON_CENTER := FishGlob_cleaned.10year.lat.lon_cellcenters$lon_deg][,LAT_CENTER := FishGlob_cleaned.10year.lat.lon_cellcenters$lat_deg]
#get the grid cell boundary for cells which had trawls
grid_FishGlob_cleaned.10year.lat.lon <- dgcellstogrid(dggs, FishGlob_cleaned.10year.lat.lon[,cell], frame = T, wrapcells = F)
#update grid properties to include # of trawls in each cell
grid_FishGlob_cleaned.10year.lat.lon <- merge(grid_FishGlob_cleaned.10year.lat.lon, FishGlob_cleaned.10year.lat.lon, by = "cell")
world <- ne_countries(scale = "medium", returnclass = "sf") #set up for world map
class(world)
global_grids <- ggplot(data = world) +
geom_sf(fill = "black", color = NA) +
geom_point(data = FishGlob_cleaned.10year.lat.lon, aes(x = longitude, y = latitude, color = survey), shape = 20, size = 0.000000001) +
# geom_polygon(grid_FishGlob_cleaned.10year.lat.lon, mapping = aes(x = long,y = lat, group = cell), inherit.aes = FALSE, fill = NA, color = "darkgrey", size = 0.1) +
theme_classic() + theme(legend.position = "none")
#save global map
ggsave(global_grids, path = here::here("figures","map_points_plots"), filename = "global_grids.jpg", height = 8, width = 12)
##Sensitivity Analyses (March 2022 @ FishGlob Montpellier)
Just year threshold sensitivity
#
#set up grid
dggs <- dgconstruct(res = 8, metric = T) #with res = 8, we will need at least n observations per year within 7,774.2 km^2 (roughly size of some NEUS strata)
percent_thresholds <- seq(0.5, 1, by = 0.01)
#empty table with sensitivity statistics
year_threshold_sensitivity_full <- data.table(matrix(ncol = 6))
colnames(year_threshold_sensitivity_full) <- c("survey_season","percent_threshold","years_deleted_percent","years_deleted_count", "obs_deleted_percent", "obs_deleted_count")
#leave out ZAF_1 and MEDITS_2 because they fail at GEO_to_SEQNUM (fix latere)
leave_out_error <- c("ZAF_1", "MEDITS_2")
all_survey_seasons <- all_survey_seasons[!(all_survey_seasons %in% leave_out_error)]
for (i in 1:length(all_survey_seasons)) {
#reduce to specific survey/season combination
reduced_FishGlob.10year <- FishGlob.10year[survey_season == all_survey_seasons[i],]
#pull out unique lat lons
unique_latlon <- unique(reduced_FishGlob.10year[,.(latitude, longitude)])
unique_latlon[,cell := dgGEO_to_SEQNUM(dggs, longitude, latitude)] #get corresponding grid cells for this region/survey combo
#find cell centers
cellcenters <- dgSEQNUM_to_GEO(dggs, unique_latlon[,cell]) #check, fails for MEDITS_2 and ZAF_1
#linking cell centers to unique_latlon
unique_latlon[,cell_center_longitude := cellcenters$lon_deg][,cell_center_latitude:= cellcenters$lat_deg]
#link centers back to main data table
reduced_FishGlob.10year.gridded <- merge(reduced_FishGlob.10year, unique_latlon, by = c("latitude", "longitude"))
#number of tows in each cell
towcount <- unique_latlon[, .N, by = cell]
#get the grid cell boundary for cells which had trawls
grid <- dgcellstogrid(dggs, unique_latlon[,cell], frame = T, wrapcells = F)
#update grid properties to include # of trawls in each cell
grid <- merge(grid, unique_latlon, by = "cell")
#Any years where clearly fewer cells were sampled?
year_cells <- reduced_FishGlob.10year.gridded[,.(cell_count = length(unique(cell))),year]
for(j in 1:length(percent_thresholds)) {
benchmark <- percent_thresholds[j] * max(year_cells[,cell_count]) # of cells/ year to cut off below
# assign(paste0("benchmark_",percent_thresholds[j]*100,"%"), benchmark) #unhash if you want to save object
#only keep years where over x% of cells are sampled
year_cells[,benchmark_met := cell_count > benchmark]
years_deleted <- year_cells[benchmark_met == F]$year #which years are left out?
years_kept <- year_cells[benchmark_met ==T]$year #which years to keep
years_deleted_percent <- length(years_deleted)/nrow(year_cells)*100
years_deleted_count <- length(years_deleted)
#reduce to years that are well sampled
reduced_FishGlob.10year.gridded.r <- reduced_FishGlob.10year.gridded[year %in% years_kept,]
#identify any cells that in any years are sampled less than 3 times
reduced_FishGlob.10year.gridded.r[,year_cell_count := length(unique(haul_id)),.(year,cell)]
#continue to limit by the number of observations for grid cell per year (start with n = 1)
#cell ids to remove and keep
#in any year, which cells are sampled less than 1 times, these need to go (sensitivity below)
cell_id_remove <- unique(reduced_FishGlob.10year.gridded.r[year_cell_count < 1,cell])
cells_deleted_percent <- length(cell_id_remove)/length(unique(reduced_FishGlob.10year.gridded.r[,cell]))
#what percent of cells are deleted
cells_deleted_count <- length(cell_id_remove)
#reduce to cells that are well sampled
reduced_FishGlob.10year.gridded.r.cell <- reduced_FishGlob.10year.gridded.r[!(cell %in% cell_id_remove),]
#add to cleaned data table of all regions don't need to do this
# FishGlob_cleaned_year_sensitivity <- rbind(FishGlob_cleaned_year_sensitivity, reduced_FishGlob.10year.gridded.r.cell)
#What percent of observations does this remove?
obs_deleted_percent <- (length(unique(reduced_FishGlob.10year[,haul_id]))-length(unique(reduced_FishGlob.10year.gridded.r.cell[,haul_id])))/length(unique(reduced_FishGlob.10year[,haul_id])) #what % obs do we lose
obs_deleted_count <- length(unique(reduced_FishGlob.10year[,haul_id]))-length(unique(reduced_FishGlob.10year.gridded.r.cell[,haul_id])) #what # obs do we lose
#add to row in small data.table
year_threshold_sensitivity <- data.table(matrix(c(all_survey_seasons[i], percent_thresholds[j],years_deleted_percent, years_deleted_count, obs_deleted_percent,obs_deleted_count), nrow = 1))
year_threshold_sensitivity_full <- rbind(year_threshold_sensitivity_full, year_threshold_sensitivity, use.names = F)
}
print(paste0(all_survey_seasons[i]))
}
#delete first empty row
year_threshold_sensitivity_full <- year_threshold_sensitivity_full[-1,]
year_threshold_sensitivity_full[,percent_threshold := as.numeric(percent_threshold)][,years_deleted_percent := as.numeric(years_deleted_percent)][,years_deleted_count := as.numeric(years_deleted_count)][,obs_deleted_percent := as.numeric(obs_deleted_percent)][,obs_deleted_count := as.numeric(obs_deleted_count)]
#Make plot
year_threshold_sensitivity_plot <- ggplot(year_threshold_sensitivity_full, aes(x = percent_threshold, y = years_deleted_percent)) +
geom_line(aes(color = survey_season)) +
# facet_wrap(~survey_season) +
theme_classic()
ggsave(year_threshold_sensitivity_plot, path = here::here("figures","sensitivity"),filename = "year_threshold_sensitivity_plot.jpg", width = 10, height = 5, unit = "in")
#Make faceted plot
year_threshold_sensitivity_plot_facet <- ggplot(year_threshold_sensitivity_full, aes(x = percent_threshold, y = years_deleted_percent)) +
geom_line() +
facet_wrap(~survey_season, ncol = 3) +
theme_classic()
ggsave(year_threshold_sensitivity_plot_facet, path = here::here("figures","sensitivity"),filename = "year_threshold_sensitivity_plot_facet.jpg", unit = "in", width = 3, height = 15)
#Make box plot
year_threshold_sensitivity_plot_box <- ggplot(year_threshold_sensitivity_full, aes(y = years_deleted_percent, x = percent_threshold, group = as.factor(percent_threshold))) +
geom_boxplot() +
theme_classic()
ggsave(year_threshold_sensitivity_plot_box, path = here::here("figures","sensitivity"),filename = "year_threshold_sensitivity_plot_box.jpg", width = 10, height = 5, unit = "in")
year_threshold_sensitivity_merge <- plot_grid(year_threshold_sensitivity_plot + theme(legend.position = "none"), year_threshold_sensitivity_plot_box + theme(axis.title.y = element_blank(), axis.text.y = element_blank()), ncol = 2, align = "hv")
ggsave(year_threshold_sensitivity_merge, path = here::here("figures","sensitivity"),filename = "year_threshold_sensitivity_merge.jpg", width = 6, height = 3, unit = "in")
#for individual hauls
#Make plot
year_threshold_sensitivity_plot_by_tow <- ggplot(year_threshold_sensitivity_full, aes(x = percent_threshold, y = 1-obs_deleted_percent)) +
geom_line(aes(color = survey_season)) +
labs(x = "Percent Threshold", y = "Percent Hauls Maintained") +
# facet_wrap(~survey_season) +
theme_classic()
ggsave(year_threshold_sensitivity_plot_by_tow, path = here::here("figures","sensitivity"),filename = "year_threshold_sensitivity_plot_by_tow.jpg", width = 10, height = 5, unit = "in")
#Make faceted plot
year_threshold_sensitivity_plot_facet_by_tow <- ggplot(year_threshold_sensitivity_full, aes(x = percent_threshold, y = 1-obs_deleted_percent)) +
labs(x = "Percent Threshold", y = "Percent Hauls Maintained") +
geom_line() +
facet_wrap(~survey_season, ncol = 3) +
theme_classic()
ggsave(year_threshold_sensitivity_plot_facet_by_tow, path = here::here("figures","sensitivity"),filename = "year_threshold_sensitivity_plot_facet_by_tow.jpg", unit = "in", width = 3, height = 15)
#Make box plot
year_threshold_sensitivity_plot_box_by_tow <- ggplot(year_threshold_sensitivity_full, aes(y = 1-obs_deleted_percent, x = percent_threshold, group = as.factor(percent_threshold))) +
labs(x = "Percent Threshold", y = "Percent Hauls Maintained") +
geom_boxplot() +
theme_classic()
ggsave(year_threshold_sensitivity_plot_box_by_tow, path = here::here("figures","sensitivity"),filename = "year_threshold_sensitivity_plot_box_by_tow.jpg", width = 10, height = 5, unit = "in")
year_threshold_sensitivity_merge_by_tow <- plot_grid(year_threshold_sensitivity_plot_by_tow + theme(legend.position = "none"), year_threshold_sensitivity_plot_box_by_tow + theme(axis.title.y = element_blank(), axis.text.y = element_blank()), ncol = 2, align = "hv")
ggsave(year_threshold_sensitivity_merge_by_tow, path = here::here("figures","sensitivity"),filename = "year_threshold_sensitivity_merge_by_tow.jpg", width = 10, height = 5, unit = "in")
Just cell count threshold sensitivity (But, should be tows, not observations)
FishGlob_cleaned_cell_sensitivity <- data.table()
#set up grid
dggs <- dgconstruct(res = 8, metric = T) #with res = 8, we will need at least 3 observations per year within 7,774.2 km^2 (roughly size of some NEUS strata)
#Keep % cut off at 70%
#Vary cell counts
cell_count_thresholds <- seq(0,10, by = 1)
#sensitivity (what portion years left out, what portion cells left out)
cell_threshold_sensitivity_full <- data.table(matrix(ncol = 6))
colnames(cell_threshold_sensitivity_full) <- c("survey_season","cell_count_threshold","cells_deleted_percent","cells_deleted_count", "obs_removed_percent","obs_removed_count")
#GSL-S_3 acting weird, leave out #23
for (i in 1:length(all_survey_seasons)) {
#reduce to specific survey/season combination
reduced_FishGlob.10year <- FishGlob.10year[survey_season == all_survey_seasons[i],]
#pull out unique lat lons
unique_latlon <- unique(reduced_FishGlob.10year[,.(latitude, longitude)])
unique_latlon[,cell := dgGEO_to_SEQNUM(dggs, longitude, latitude)] #get corresponding grid cells for this region/survey combo
#find cell centers
cellcenters <- dgSEQNUM_to_GEO(dggs, unique_latlon[,cell])
#linking cell centers to unique_latlon
unique_latlon[,cell_center_longitude_s := cellcenters$lon_deg][,cell_center_latitude:= cellcenters$lat_deg]
#link centers back to main data table
reduced_FishGlob.10year.gridded <- merge(reduced_FishGlob.10year, unique_latlon, by = c("latitude", "longitude"))
#number of tows in each cell
towcount <- unique_latlon[, .N, by = cell]
#get the grid cell boundary for cells which had trawls
grid <- dgcellstogrid(dggs, unique_latlon[,cell], frame = T, wrapcells = F)
#update grid properties to include # of trawls in each cell
grid <- merge(grid, unique_latlon, by = "cell")
#Any years where clearly fewer cells were sampled?
year_cells <- reduced_FishGlob.10year.gridded[,.(cell_count = length(unique(cell))),year]
#set year benchmark to 70%
benchmark <- percent_thresholds[21] * max(year_cells[,cell_count]) # of cells/ year to cut off below
# assign(paste0("benchmark_",percent_thresholds[j]*100,"%"), benchmark) #unhash if you want to save object
#only keep years where over x% of cells are sampled
year_cells[,benchmark_met := cell_count > benchmark]
# years_deleted <- year_cells[benchmark_met == F]$year #which years are left out?
years_kept <- year_cells[benchmark_met ==T]$year #which years to keep
# years_deleted_percent <- length(years_deleted)/nrow(year_cells)*100
# years_deleted_count <- length(years_deleted)
# year_threshold_sensitivity <- data.table(matrix(c(all_survey_seasons[i], percent_thresholds[j],years_deleted_percent, years_deleted_count), nrow = 1))
# year_threshold_sensitivity_full <- rbind(year_threshold_sensitivity_full, year_threshold_sensitivity, use.names = F)
#reduce to years that are well sampled
reduced_FishGlob.10year.gridded.r <- reduced_FishGlob.10year.gridded[year %in% years_kept,]
#identify any cells that in any years are sampled less than 3 times
reduced_FishGlob.10year.gridded.r[,year_cell_count := length(unique(haul_id)),.(year,cell)]
for (k in 1:length(cell_count_thresholds)) {
#cell ids to remove and keep
#in any year, which cells are sampled less than x times, these need to go
cell_id_remove <- unique(reduced_FishGlob.10year.gridded.r[year_cell_count < cell_count_thresholds[k],cell])
cells_deleted_percent <- length(cell_id_remove)/length(unique(reduced_FishGlob.10year.gridded.r[,cell]))
#what percent of cells are deleted
cells_deleted_count <- length(cell_id_remove)
#reduce to cells that are well sampled
reduced_FishGlob.10year.gridded.r.cell <- reduced_FishGlob.10year.gridded.r[!cell %in% cell_id_remove,]
#add to cleaned data table of all regions
FishGlob_cleaned_cell_sensitivity <- rbind(FishGlob_cleaned_cell_sensitivity, reduced_FishGlob.10year.gridded.r.cell)
#What percent of observations does this remove?
obs_removed_percent <- (nrow(reduced_FishGlob.10year.gridded.r)-nrow(reduced_FishGlob.10year.gridded.r.cell))/nrow(reduced_FishGlob.10year.gridded.r) #what % obs do we lose
obs_removed_count <- nrow(reduced_FishGlob.10year.gridded.r)-nrow(reduced_FishGlob.10year.gridded.r.cell) #what # obs do we lose
#add to row in small data.table
cell_threshold_sensitivity <- data.table(matrix(c(all_survey_seasons[i], cell_count_thresholds[k],cells_deleted_percent, cells_deleted_count, obs_removed_percent, obs_removed_count), nrow = 1))
#combine with full data.table
cell_threshold_sensitivity_full <- rbind(cell_threshold_sensitivity_full, cell_threshold_sensitivity, use.names = F)
}
print(paste0(all_survey_seasons[i]))
}
#delete first empty row
cell_threshold_sensitivity_full <- cell_threshold_sensitivity_full[-1,]
cell_threshold_sensitivity_full[,cell_count_threshold := as.numeric(cell_count_threshold)][,cells_deleted_percent := as.numeric(cells_deleted_percent)][,cells_deleted_count := as.numeric(cells_deleted_count)][,obs_removed_percent := as.numeric(obs_removed_percent)][,obs_removed_count := as.numeric(obs_removed_count)]
#Make plot
cell_threshold_sensitivity_plot <- ggplot(cell_threshold_sensitivity_full, aes(x = cell_count_threshold, y = cells_deleted_percent)) +
geom_point()
geom_line(aes(color = survey_season)) +
# facet_wrap(~survey_season) +
theme_classic()
ggsave(cell_threshold_sensitivity_plot, path = here::here("figures","sensitivity"),filename = "cell_threshold_sensitivity_plot.jpg", width = 10, height = 5, unit = "in")
#Make faceted plot
cell_threshold_sensitivity_plot_facet <- ggplot(cell_threshold_sensitivity_full, aes(x = percent_threshold, y = cells_deleted_percent)) +
geom_line() +
facet_wrap(~survey_season, ncol = 3) +
theme_classic()
ggsave(cell_threshold_sensitivity_plot_facet, path = here::here("figures","sensitivity"),filename = "cell_threshold_sensitivity_plot_facet.jpg", unit = "in", width = 3, height = 15)
#Make box plot
cell_threshold_sensitivity_plot_box <- ggplot(year_threshold_sensitivity_full, aes(y = cells_deleted_percent, x = percent_threshold, group = as.factor(percent_threshold))) +
geom_boxplot() +
theme_classic()
ggsave(cell_threshold_sensitivity_plot_box, path = here::here("figures","sensitivity"),filename = "cell_threshold_sensitivity_plot_box.jpg", width = 10, height = 5, unit = "in")
cell_threshold_sensitivity_merge <- plot_grid(cell_threshold_sensitivity_plot + theme(legend.position = "none"), cell_threshold_sensitivity_plot_box + theme(axis.title.y = element_blank(), axis.text.y = element_blank()), ncol = 2, align = "hv")
ggsave(cell_threshold_sensitivity_merge, path = here::here("figures","sensitivity"),filename = "cell_threshold_sensitivity_merge.jpg", width = 6, height = 3, unit = "in")
#What about observations instead of cells?
#Make plot
cell_threshold_obs_sensitivity_plot <- ggplot(cell_threshold_sensitivity_full, aes(x = cell_count_threshold, y = 1-obs_removed_percent)) +
geom_line(aes(color = survey_season)) +
labs(x = "Tows per Cell Threshold", y = "Percent Hauls Maintained") +
# facet_wrap(~survey_season) +
theme_classic()
ggsave(cell_threshold_obs_sensitivity_plot, path = here::here("figures","sensitivity"),filename = "cell_threshold_obs_sensitivity_plot.jpg", width = 10, height = 5, unit = "in")
#Make faceted plot
cell_threshold_obs_sensitivity_plot_facet <- ggplot(cell_threshold_sensitivity_full, aes(x = cell_count_threshold, y = 1-obs_removed_percent)) +
geom_line() +
labs(x = "Tows per Cell Threshold", y = "Percent Hauls Maintained") +
facet_wrap(~survey_season, ncol = 3) +
theme_classic()
ggsave(cell_threshold_obs_sensitivity_plot_facet, path = here::here("figures","sensitivity"),filename = "cell_threshold_obs_sensitivity_plot_facet.jpg", unit = "in", width = 3, height = 15)
#Make box plot
cell_threshold_obs_sensitivity_plot_box <- ggplot(cell_threshold_sensitivity_full, aes(y = 1-obs_removed_percent, x = cell_count_threshold, group = cell_count_threshold)) +
labs(x = "Tows per Cell Threshold", y = "Percent Hauls Maintained") +
geom_boxplot() +
theme_classic()
ggsave(cell_threshold_obs_sensitivity_plot_box, path = here::here("figures","sensitivity"),filename = "cell_threshold_obs_sensitivity_plot_box.jpg", width = 10, height = 5, unit = "in")
cell_threshold_obs_sensitivity_merge <- plot_grid(cell_threshold_obs_sensitivity_plot + theme(legend.position = "none"), cell_threshold_obs_sensitivity_plot_box + theme(axis.title.y = element_blank(), axis.text.y = element_blank()), ncol = 2, align = "hv")
ggsave(cell_threshold_obs_sensitivity_merge, path = here::here("figures","sensitivity"),filename = "cell_threshold_obs_sensitivity_merge.jpg", width = 6, height = 3, unit = "in")